Just Call Me Internet/Just Call Me Internet.iso/prog/atari/m2/cat3src/cat/printer.i

Text File | 1997-10-26 | 18KB | 652 lines

IMPLEMENTATION MODULE Printer;
(*****************************************************************************
  Projekt:
  Datei  : PRINTER.M
  Datum  : 21.12.1991
  Autor  : Uwe Mindrup, Wolfsgrubenstraže 23, 74379 Ingersheim, Tel: [phone]
           Uwe Mindrup @ S3
******************************************************************************)

FROM SYSTEM IMPORT ADDRESS, ADR;
IMPORT Storage,
       CatGlobal,    (* vorher: FSelect *)
       MagicDOS,     (* vorher: MagicDOS, *)
                     (* Streams, ebenfalls durch direkt MagicDOS-Calls ersetzt *)
       Strings,      (* vorher: String *)
       SysVars,      (* vorher: SysVar *)
       SysUtil1;

TYPE   tTableEntry = RECORD
                       len,
                       pos  : SHORTINT;
                     END;

CONST cMaxSequence     = 4FH;
      cMaxTranslations = 0FFH;
      (* es folgen die Konstanten fr den Tabelleneingang der Funktionen: *)
      cVertPos         = 5;      (* absolute vertikale Positionierung *)
      cBold            = 6;
      cItalic          = 0AH;
      cLight           = 0EH;
      cSuperscript     = 12H;
      cSubscript       = 16H;
      cUnderline       = 1AH;
      cHorzInit        = 1FH;
      cVertInit        = 20H;
      cPrinterInit     = 21H;

      c1stType         = 28H;
      c1stColor        = 30H;
      cProp            = 35H;
      cFormFeed        = 1EH;
      cWriteLn         = 1;
      cTab             = 11C;

VAR
    SeqTable     : ARRAY[0..cMaxSequence]     OF tTableEntry;
    TransTable   : ARRAY[0..cMaxTranslations] OF tTableEntry;
    CFG          : POINTER TO ARRAY [0..MAX(SHORTINT)] OF CHAR;
    TabSize      : SHORTINT;
    NLQSet       : SHORTINT; (* [0..2] *)
    CharPos,                 (* Position des Zeichens in der aktuellen Zeile *)
    NrSpaces,                (* Anzahl Leerzeichen *)
    PropSize     : SHORTINT;
    PrnHdl       : SHORTINT;
    Proportional : BOOLEAN;
    AktColor,
    AktMode      : SHORTINT;

(* Ersatz fr das Streams-Modul: Die Variablen *)
VAR currentOut   : SHORTINT;     (* Das Handle des Kanals *)

PROCEDURE InitTables();
(* Tabellen initialisieren: *)
VAR
(*$Reg *) i : SHORTCARD;
BEGIN (* Init *)
  (* Sequence- und Translationtable l”schen: *)
  FOR i := 0 TO cMaxSequence     DO SeqTable[i].len := 0   END;
  FOR i := 0 TO cMaxTranslations DO TransTable[i].len := 0 END;
  CharPos := 0;
END InitTables;

VAR hz200 : LONGCARD;

PROCEDURE T200Hz () : LONGCARD;
BEGIN
  RETURN SysUtil1.SuperLPeek(SysVars._hz_200);
END T200Hz;

PROCEDURE Error (Err: tResponse);
(* Ausgabe eines Fehlers; die globale Variable 'Response' wird gesetzt und
   die benutzerdefinierbare Fehlerfunktion wird aufgerufen.
 *)
  VAR voidO : BOOLEAN;
BEGIN
  Response := Err;
  voidO := ErrorProc(Err);
END Error;

PROCEDURE QError (Err: tResponse): BOOLEAN;
(* Ausgabe eines Fehlers; die globale Variable 'Response' wird gesetzt und
   die benutzerdefinierbare Fehlerfunktion wird aufgerufen.
 *)
BEGIN
  Response := Err;
  RETURN ErrorProc(Err)
END QError;

PROCEDURE DummyError(Err: tResponse): BOOLEAN;
(* Einfachste Form einer Fehlerbehandlung ist die: nichts tun *)
BEGIN
  RETURN TRUE
END DummyError;

PROCEDURE Out(ch: CHAR);
(*  Ausgabe eines einzelnen Zeichens; es wird VOR der Ausgabe geprft, ob der
 *  Kanal berhaupt 'ready' ist.
 *)
VAR
(*$Reg *) Ok,
(*$Reg *) Cancel: BOOLEAN;
(*$Reg *) Timer : LONGCARD;
          len   : LONGCARD;
BEGIN (* Out *)
  REPEAT
    Timer := 1000 + T200Hz();
    IF currentOut = 2 THEN
      REPEAT
        Ok := MagicDOS.Cauxos()
      UNTIL Ok OR (Timer < T200Hz());
      IF NOT Ok THEN
        Cancel := NOT QError(AuxDeviceBusy)
      END;
    ELSIF currentOut = 3 THEN
      REPEAT
        Ok := MagicDOS.Cprnos();
      UNTIL Ok OR (Timer < T200Hz());
      IF NOT Ok THEN
        Cancel := NOT QError(PrnDeviceBusy)
       END;
    ELSE
      Ok := TRUE
    END;
  UNTIL Ok OR Cancel;

  IF Ok THEN
    len := 1;
    MagicDOS.Fwrite (PrnHdl, len, ADR(ch));
    IF len = 1 THEN
      Response := done;
    ELSE
      IF currentOut = 2
      THEN
        Cancel := NOT QError (AuxDeviceBusy)
      ELSIF currentOut = 3
      THEN
        Cancel := NOT QError (PrnDeviceBusy)
      ELSE
        Cancel := TRUE;
      END;
      IF Cancel
      THEN
        Error (Cancelled);
      END;
    END;
  ELSE
    Error(Cancelled)
  END;
END Out;


PROCEDURE FreeCFGFile();
(* L”scht eine bereits geladene CFG-Datei aus dem Speicher
 *)
BEGIN
  IF CFG <> NIL THEN
    (* noch ein Printertreiber eingeh„ngt; ganz frech einfach freigeben: *)
    Storage.DEALLOCATE(CFG, 0);
  END; (* IF CFG <> NIL *)
END FreeCFGFile;

PROCEDURE LoadCFGFile(VAR name: ARRAY OF CHAR);
(* Er”ffnung einer CFG-Datei. Der komplette Dateiname muž bergeben werden.
   Falls keine Er”ffnung m”glich war, wird 'Response' auf 'CFGnotFound' gesetzt.
   Die Datei wird nach Er”ffnung auf die Dateikennung in den ersten 8 Bytes
   berprft ('GST-CFG:'). Falls die Kennung nicht bereinstimmt, wird
   die Datei wieder geschlossen und 'Response' auf 'wrongIdent' gesetzt.
   Im Erfolgsfall enth„lt 'Response' dann 'done'.
*)
VAR     f       : SHORTINT;
        DOSRet,
        Length  : LONGCARD;                  (* nimmt die Dateil„nge auf. *)
        cKennung,
        Kennung : ARRAY[0..8] OF CHAR;
        res     : SHORTINT;
        voidO   : BOOLEAN;
(*$Reg *) i,
(*$Reg *) j,
(*$Reg *) Pos,
(*$Reg *) Len : SHORTCARD;                     (* Schleifenvariable         *)
BEGIN (* LoadCFGFile *)
  f := MagicDOS.Fopen(name, MagicDOS.Read);
  IF f < 0 THEN
    Error(CFGnotFound);
    RETURN;
  END;

  IF CFG <> NIL THEN
    (* noch ein Printertreiber eingeh„ngt; ganz frech einfach freigeben: *)
    Storage.DEALLOCATE(CFG, 0);
  END; (* IF CFG <> NIL *)

  Length := MagicDOS.Fseek(0, f, MagicDOS.SeekEnd);

  Storage.ALLOCATE(CFG, Length);
  IF CFG = NIL THEN
    Error(noMemory);
    res := MagicDOS.Fclose(f);
    RETURN;
  END;
  InitTables();

  DOSRet := MagicDOS.Fseek(0, f, MagicDOS.SeekStart);
  MagicDOS.Fread(f, Length, ADR(CFG^));
  res := MagicDOS.Fclose(f);

  (* Kennung berprfen: *)
  cKennung := "GST-CFG:";   (* Kennung einer GST-Datei *)
  Strings.Copy(CFG^, 0, 8, Kennung, voidO);
  IF ~Strings.StrEqual (Kennung, cKennung) THEN
    Error(wrongIdent); (* Keine GST-CFG-Datei !!! *)
    RETURN;
  END;
  (* Jetzt mssen die Tabellen aufgebaut werden: *)
  i := 8; (* Lesezeiger auf den Beginn des Druckernamens setzen:  *)
  REPEAT
    INC(i)
  UNTIL CFG^[i] = 0C; (* Ende des Druckernamens gefunden. *)

  INC(i, 7); (* Druckeranpassungen interessieren nicht.  *)

  (* zun„chst die Tabelle der Druckerbesonderheiten:  *)
  WHILE CFG^[i] <> 0C DO (* Tabelle wird mit einem NUL-Byte beendet *)
    Len := ORD(CFG^[i]);
    Pos := ORD(CFG^[i+1]);  (* Tabelleneintrag *)
    WITH SeqTable[Pos] DO
      len  := Len - 2;
      pos  := i+2;
    END;
    INC(i, Len);
  END; (* WHILE CFG^[i] <> 0C *)

  INC(i); (* Tabellenende berspringen *)
  (* jetzt die šbersetzungsTabelle:  *)
  WHILE CFG^[i] <> 0C DO (* Tabelle wird mit einem NUL-Byte beendet *)
    Len := ORD(CFG^[i]);
    Pos := ORD(CFG^[i+1]);  (* Tabelleneintrag *)
    WITH TransTable[Pos] DO
      IF Len >= 2
      THEN
        len  := Len - 2;
      ELSE
        len := 0;
      END;
      pos  := i+2;
    END;
    INC(i, Len);
  END; (* WHILE CFG^[i] <> 0C *)

  (* Optimierung der Druckercharakteristik-Tabelle: *)
  (* 1. die Texteffekte: *)
  FOR i := cBold TO cUnderline BY 4 DO
    FOR j := i TO i+1 DO
      IF (SeqTable[j].len = 0) AND (SeqTable[j+2].len <> 0) THEN
        SeqTable[j] := SeqTable[j+2]
      END;
     IF (SeqTable[j+2].len = 0) AND (SeqTable[j].len <> 0) THEN
        SeqTable[j+2] := SeqTable[j]
      END;
   END;
  END;
  (* 2. die Schriftarten: *)
  FOR i := c1stType TO c1stType + 6 BY 2 DO
    IF (SeqTable[i].len = 0) AND (SeqTable[i+1].len <> 0) THEN
      SeqTable[i] := SeqTable[i+1]
    END;
   IF (SeqTable[i+1].len = 0) AND (SeqTable[i].len <> 0) THEN
      SeqTable[i+1] := SeqTable[i]
    END;
  END;
  Response := done;
END LoadCFGFile;


PROCEDURE QueryCFGFile(VAR path, name    : ARRAY OF CHAR;
                       REF InfoText: ARRAY OF CHAR);
(* erfragt eine CFG-Datei per FileSelectBox.
   InfoText ist fr die FileSelectBox gedacht.
   Die Endung wird fest auf '*.CFG' festgeschrieben.
*)
  VAR fullname : ARRAY [0..255] OF CHAR;
      voidO    : BOOLEAN;
BEGIN (* QueryCFGFile *)
  IF CatGlobal.FselGet (path, name, '*.cfg', InfoText, FALSE) THEN
    Strings.Concat (path, name, fullname, voidO);
    LoadCFGFile(fullname);
  END; (* IF FSelect.Input(name, '*.cfg', InfoText *)
END QueryCFGFile;


PROCEDURE GetPrnName(VAR Printername: ARRAY OF CHAR);
(* Eingetragenen Druckernamen liefern. Falls keiner vorhanden ist, dann
   wird ein Leerstring ('') geliefert.
 *)
VAR
(*$Reg *) i : SHORTINT;
BEGIN (* GetPrnName *)
  IF CFG # NIL THEN
    i := 8;
    WHILE CFG^[i] <> 0C DO
      Printername[i-8] := CFG^[i];
      INC(i);
    END;
    Printername[i-8] := 0C;
  ELSE
    Printername[0] := ""
  END;
END GetPrnName;


PROCEDURE PrintSeq(Which: SHORTINT);
VAR (*$Reg *) i: SHORTINT;
BEGIN (* PrintSeq *)
  WITH SeqTable[Which] DO
    FOR i := pos TO pos + len - 1 DO
      Out(CFG^[i]);
      IF Response # done THEN RETURN END;
    END;
  END; (* WITH SeqTable[Which] *)
END PrintSeq;


PROCEDURE Print(Entry: SHORTINT; Set : BOOLEAN);
(*  Ausgabe der angew„hlten Steuersequenz. *)
BEGIN (* Print *)
  IF NOT Set THEN
    INC(Entry);
  END;
  PrintSeq(Entry + NLQSet);
END Print;


PROCEDURE SendExit();
BEGIN (* SendReset *)
  PrintSeq(cPrinterInit);
END SendExit;


PROCEDURE SendInit(NLQ: BOOLEAN; hAndVInit : BOOLEAN);     (* Drucker initialisieren             *)
BEGIN (* SendInit *)
  NLQSet := 0;
  IF NLQ THEN
    NLQSet := 2;
  END;
  IF hAndVInit
  THEN
    PrintSeq(cHorzInit);        (* Horizontale Initialisierung *)
    IF Response # done THEN RETURN END;
    PrintSeq(cVertInit);        (* Vertikale Initialisierung   *)
    IF Response # done THEN RETURN END;
  END;
  Print(cBold, FALSE);        (* Fettschrift aus.            *)
  IF Response # done THEN RETURN END;
  Print(cItalic, FALSE);      (* Kursivschrift aus.          *)
  IF Response # done THEN RETURN END;
  Print(cLight, FALSE);       (* Light aus.                  *)
  IF Response # done THEN RETURN END;
  Print(cSuperscript, FALSE); (* Superscript aus.            *)
  IF Response # done THEN RETURN END;
  Print(cSubscript, FALSE);   (* Subscript aus.              *)
  IF Response # done THEN RETURN END;
  Print(cUnderline, FALSE);   (* Unterstreichung aus.        *)
  IF Response # done THEN RETURN END;

  AktMode  := -1;
  PrintSeq(c1stType);         (* PICA (10 CPI)               *)
  IF Response # done THEN RETURN END;
  AktColor := -1;
  PrintSeq(c1stColor);        (* Color-Einstellung: Black.   *)
  IF Response # done THEN RETURN END;
  Proportional := FALSE;
  PrintSeq(cProp + 1);        (* Proportional-Schrift aus.   *)
END SendInit;


PROCEDURE Bold(Set: BOOLEAN);         (* Fettdruck ein/ausschalten          *)
BEGIN (* Bold *)
  Print(cBold, Set);
END Bold;

PROCEDURE Italic(Set: BOOLEAN);       (* Schr„gschrift ein/ausschalten      *)
BEGIN (* Italic *)
  Print(cItalic, Set);
END Italic;

PROCEDURE Light(Set: BOOLEAN);        (* Helle Schrift ein/ausschalten      *)
BEGIN (* Light *)
  Print(cLight, Set);
END Light;

PROCEDURE Superscript(Set: BOOLEAN);  (* Hochstellen ein/ausschalten        *)
BEGIN (* Superscript *)
  Print(cSuperscript, Set);
END Superscript;

PROCEDURE Subscript(Set: BOOLEAN);    (* Tiefstellen ein/ausschalten        *)
BEGIN (* Subscript *)
  Print(cSubscript, Set);
END Subscript;

PROCEDURE Underline(Set: BOOLEAN);    (* Unterstreichen ein/ausschalten     *)
BEGIN (* Underline *)
  Print(cUnderline, Set);
END Underline;

PROCEDURE Effect(Effects: BITSET; Set: BOOLEAN);
(* Texteffekte setzen/rcksetzen *)
VAR (*$Reg *) i : SHORTCARD;
BEGIN (* Effect *)
  FOR i := cFat TO cUnderlined DO
    IF i IN Effects THEN
      CASE i OF
        cFat        : Bold(Set);
      | cLightened  : Light(Set);
      | cSlanted    : Italic(Set);
      | cUnderlined : Underline(Set);
      ELSE
      END;
    END;
  END;
END Effect;


PROCEDURE FormFeed();
(*  Seitenvorschub ausgeben *)
BEGIN (* FormFeed *)
  IF CFG # NIL
  THEN
    PrintSeq(cFormFeed);
    CharPos := 0;
  ELSE
    Write (14C);
    CharPos := 0;
  END;
END FormFeed;

PROCEDURE SetTabSize(Tab: SHORTINT);
BEGIN (* SetTabSize *)
  TabSize := Tab;
END SetTabSize;

PROCEDURE SetPropSize(Prop: BOOLEAN; PSize: SHORTINT);
(* Ein/Ausschalten der Proportionalschrift sowie Setzen einer mittleren
   Zeichenbreite (fr Tabulierung notwendig)
*)
VAR (*$Reg *) nlq : SHORTINT;
BEGIN (* SetPropSize *)
  nlq := NLQSet;
  NLQSet := 0;
  Print(cProp, Prop);
  NLQSet := nlq;
  PropSize := PSize;
  Proportional := Prop;
END SetPropSize;

PROCEDURE WriteLn();
(*  Zeilenvorschub ausgeben *)
BEGIN (* WriteLn *)
  IF CFG # NIL
  THEN
    PrintSeq(cWriteLn);
    CharPos := 0;
  ELSE
    Write (15C);
    Write (12C);
    CharPos := 0;
  END;
END WriteLn;

PROCEDURE SetMode(Mode : SHORTINT);
(*  Zeichenbreite einstellen.
    ACHTUNG: vorher Druckmodus 'DRAFT' oder 'NLQ' einstellen!
 *)
BEGIN (* SetMode *)
  IF (Mode >= cPica) AND (Mode <= cExpanded) THEN
    IF Mode <> AktMode THEN
      PrintSeq(2 * Mode + c1stType + (NLQSet DIV 2));
      AktMode := Mode;
    END;
  END;
END SetMode;

PROCEDURE SetColor(Color : SHORTINT);
(*  Farbe einstellen. *)
BEGIN (* SetColor *)
  IF (Color >= cBlack) AND (Color <= cYellow) THEN
    IF Color <> AktColor THEN
      PrintSeq(Color + c1stColor);
      AktColor := Color;
    END;
  END;
END SetColor;

PROCEDURE SetHead();
(*  Druckkopf neu positionieren *)
VAR
(*$Reg *) i : SHORTINT;
BEGIN (* SetHead *)
  WITH SeqTable[cVertPos] DO
    FOR i := pos TO pos + len - 1 DO
      IF CFG^[i] = CHAR(80H) THEN
        Out(CHR((CharPos * 60 DIV PropSize) MOD 256))
      ELSIF CFG^[i] = CHAR(81H) THEN
        Out(CHR((CharPos * 60 DIV PropSize) DIV 256))
      ELSE
        Out(CFG^[i]);
      END;
    END; (* FOR i := pos ... *)
  END; (* WITH SeqTable[cVertPos] *)
  NrSpaces := 0;
END SetHead;

PROCEDURE WriteChar(ch: CHAR);
VAR
(*$Reg *) i : SHORTINT;
BEGIN (* *)
  WITH TransTable[ORD(ch)] DO
    IF len > 0 THEN
      FOR i := pos TO pos + len - 1 DO
        Out(CFG^[i]);
        IF Response # done THEN RETURN END;
      END;
      INC(CharPos);
    ELSE
      Out(ch); (* Zeichen ohne šbersetzung ausgeben. *)
      INC(CharPos);
    END;
  END; (* WITH TransTable[ORD(ch)] *)
END WriteChar;

PROCEDURE Write(ch: CHAR);
(*  Zentrale Prozedur fr die šbersetzung der einzelnen Zeichen in eine
    Zeichenfolge.
 *)
VAR (*$Reg *) i : SHORTINT;
BEGIN (* Write *)
  IF (ch = cTab) OR (ch = ' ') THEN
    IF Proportional THEN
      IF ch = ' ' THEN
        INC(CharPos);
        INC(NrSpaces);
      ELSE
        INC(CharPos,  TabSize);
        INC(NrSpaces, TabSize);
      END;
    ELSE
      IF ch = ' ' THEN
        WriteChar(' ')
      ELSE
        FOR i := 1 TO TabSize DO
          WriteChar(' ');
          IF Response # done THEN RETURN END;
        END;
      END;
    END;
  ELSE
    IF NrSpaces > 1 THEN
      SetHead();
    ELSIF NrSpaces = 1 THEN
      WriteChar(' ');
      NrSpaces := 0;
    END;
    WriteChar(ch);
  END;
END Write;

PROCEDURE WriteString(REF Str: ARRAY OF CHAR);
VAR (*$Reg *) i : SHORTINT;
BEGIN (* WriteString *)
  i := 0;
  WHILE Str[i] <> 0C DO
    Write(Str[i]);
    IF Response # done THEN RETURN END;
    INC(i)
  END;
END WriteString;

PROCEDURE Open(REF Name: ARRAY OF CHAR);
(* Er”ffnung eines Druckerkanals; wenn ein Fehler auftritt, wird 'Response'
   auf 'ErrorInStreams' gestellt; die eigentliche Fehlerursache ist dann bei
   'Streams.Response' zu suchen.
*)
VAR (*$Reg *) i,
    (*$Reg *) Device: SHORTINT;
            str   : ARRAY[0..3] OF CHAR;
BEGIN (* Open *)
  Response := done;

  (* Zum Stringvergleich die 3 ersten Zeichen kapitalisieren: *)
  FOR i := 0 TO 3 DO
    IF Name[i] <> 0C THEN str[i] := CAP(Name[i]) END;
  END;
  Device := 0;
  IF LONGCARD(str)=LONGCARD(cCon) THEN Device := 1 END;
  IF LONGCARD(str)=LONGCARD(cAux) THEN Device := 2 END;
  IF LONGCARD(str)=LONGCARD(cPrn) THEN Device := 3 END;

  IF Device = 0 THEN     (* Wird wohl ein File sein *)
    PrnHdl := MagicDOS.Fcreate (Name, {});
  ELSE
    PrnHdl := MagicDOS.Fopen (Name, {MagicDOS.Write});
  END;
  IF PrnHdl < 0
  THEN
    IF PrnHdl # -Device THEN
      Error(ErrorInStreams)
    END;
  END;
END Open;

PROCEDURE Close();
(* Schliežung eines Druckerkanals; wenn ein Fehler auftritt, wird 'Response'
   auf 'ErrorInStreams' gestellt; die eigentliche Fehlerursache ist dann bei
   'Streams.Response' zu suchen.
*)
  VAR res : INTEGER;
BEGIN (* Close *)
  res := MagicDOS.Fclose (PrnHdl);
  (*
  IF Streams.currentOut > 3 THEN
    Streams.Close(PrnHdl);
  ELSE
    Streams.StdOutputProc(Streams.currentOut);
  END;
  IF Streams.Response <> Streams.done THEN
    Error(ErrorInStreams);
  ELSE
    Response := done
  END;
  *)
END Close;

BEGIN
  ErrorProc := DummyError;
  CFG       := NIL;     (* Zeiger auf die CFG-Informationen initialisieren. *)
  NLQSet    := 0;       (* Schriftqualit„t auf Draft. *)
  TabSize   := 8;       (* Standard-Tabweite *)
  NrSpaces  := 0;
  InitTables();
END Printer.